home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / sortdemo.zip / SDTIME.INC < prev    next >
Text File  |  1992-04-15  |  7KB  |  205 lines
  1. (*
  2. ╔═══════════════════════════════════════════════════════════════════════════╗
  3. ║ Turbo Pascal 6.0 Include File : SDTIME.INC                                ║
  4. ╟───────────────────────────────────────────────────────────────────────────╢
  5. ║ Program : SORTDEMO.PAS                                                    ║
  6. ╟───────────────────────────────────────────────────────────────────────────╢
  7. ║ Version : 1.0                                                             ║
  8. ╟───────────────────────────────────────────────────────────────────────────╢
  9. ║ Copyright (c) 1992  by  Jon S. Russell                                    ║
  10. ╟───────────────────────────────────────────────────────────────────────────╢
  11. ║ Time-keeping routines for SORTDEMO.PAS                                    ║
  12. ╚═══════════════════════════════════════════════════════════════════════════╝
  13.                                                                            *)
  14. procedure GetTimeDate (var TD : TimeDateType);
  15. begin  (* GetTimeDate *)
  16.   GetTime(TD.Time.Hour, TD.Time.Minute, TD.Time.Second, TD.Time.Sec100);
  17.   GetDate(TD.Date.Year, TD.Date.Month, TD.Date.Day, TD.Date.DayOfWeek);
  18. end;   (* GetTimeDate *)
  19.  
  20. (*─────────────────────────────────────────────────────────────────────────*)
  21.  
  22. procedure CalcTimeDateDifference (    Start : TimeDateType;
  23.                                       Stop  : TimeDateType;
  24.                                   var Diff  : DiffType);
  25. var
  26.   JulianStart : real;
  27.   JulianStop  : real;
  28.  
  29.   (*───────────────────────────────────────────────────────────────────────*)
  30.  
  31.   function Julian (    InYear  : word;
  32.                        InMonth : word;
  33.                        InDay   : word) : real;
  34.   var
  35.     Cent     : integer;
  36.     CentY    : integer;
  37.     Month    : integer;
  38.     Year     : integer;
  39.     OutDay   : integer;
  40.     LongDay  : real;
  41.     TempLong : real;
  42.  
  43.   begin  (* Julian *)
  44.     if (InMonth > 2)
  45.       then
  46.         begin
  47.           Month := InMonth-3;
  48.           Year := InYear;
  49.         end
  50.       else
  51.         begin
  52.           Month := InMonth+9;
  53.           Year := InYear-1;
  54.         end;
  55.  
  56.     TempLong := 146097;
  57.     Cent := Year div 100;
  58.     CentY := Year - (Cent * 100);
  59.     LongDay := TempLong * Cent / 4;
  60.     LongDay := LongDay + 1461.0 * CentY / 4;
  61.     LongDay := LongDay + (153 * Month + 2) / 5;
  62.     LongDay := LongDay + InDay;
  63.     Julian := LongDay;
  64.   end;   (* Julian *)
  65.  
  66.   (*───────────────────────────────────────────────────────────────────────*)
  67.  
  68.   procedure BorrowDay (var Time : TimeType;
  69.                        var Days : word);
  70.  
  71.   begin  (* BorrowDay *)
  72.     inc(Time.Hour, 24);
  73.     dec(Days);
  74.   end;   (* BorrowDay *)
  75.  
  76.   (*───────────────────────────────────────────────────────────────────────*)
  77.  
  78.   procedure BorrowHour (var Time : TimeType;
  79.                         var Days : word);
  80.  
  81.   begin  (* BorrowHour *)
  82.     if (Time.Hour = 0) then BorrowDay(Time, Days);
  83.     inc(Time.Minute, 60);
  84.     dec(Time.Hour);
  85.   end;   (* BorrowHour *)
  86.  
  87.   (*───────────────────────────────────────────────────────────────────────*)
  88.  
  89.   procedure BorrowMinute (var Time : TimeType;
  90.                           var Days : word);
  91.  
  92.   begin  (* BorrowMinute *)
  93.     if (Time.Minute = 0) then BorrowHour(Time, Days);
  94.     inc(Time.Second, 60);
  95.     dec(Time.Minute);
  96.   end;   (* BorrowMinute *)
  97.  
  98.   (*───────────────────────────────────────────────────────────────────────*)
  99.  
  100.   procedure BorrowSecond (var Time : TimeType;
  101.                           var Days : word);
  102.  
  103.   begin  (* BorrowSecond *)
  104.     if (Time.Second = 0) then BorrowMinute(Time, Days);
  105.     inc(Time.Sec100, 100);
  106.     dec(Time.Second);
  107.   end;   (* BorrowSecond *)
  108.  
  109.   (*───────────────────────────────────────────────────────────────────────*)
  110.  
  111. begin  (* CalcTimeDateDifference *)
  112.   JulianStart := Julian(Start.Date.Year, Start.Date.Month, Start.Date.Day);
  113.   JulianStop := Julian(Stop.Date.Year, Stop.Date.Month, Stop.Date.Day);
  114.   Diff.Days := round(JulianStop - JulianStart);
  115.  
  116.   if (Start.Time.Sec100 > Stop.Time.Sec100)
  117.     then BorrowSecond(Stop.Time, Diff.Days);
  118.   Diff.Sec100s := Stop.Time.Sec100 - Start.Time.Sec100;
  119.  
  120.   if (Start.Time.Second > Stop.Time.Second)
  121.     then BorrowMinute(Stop.Time, Diff.Days);
  122.   Diff.Seconds := Stop.Time.Second - Start.Time.Second;
  123.  
  124.   if (Start.Time.Minute > Stop.Time.Minute)
  125.     then BorrowHour(Stop.Time, Diff.Days);
  126.   Diff.Minutes := Stop.Time.Minute - Start.Time.Minute;
  127.  
  128.   if (Start.Time.Hour > Stop.Time.Hour)
  129.     then BorrowDay(Stop.Time, Diff.Days);
  130.   Diff.Hours := Stop.Time.Hour - Start.Time.Hour;
  131. end;   (* CalcTimeDateDifference *)
  132.  
  133. (*─────────────────────────────────────────────────────────────────────────*)
  134.  
  135. function TimeDate2Str ( TD : TimeDateType) : string;
  136. var
  137.   TimeStr : string;
  138.   DateStr : string;
  139.  
  140.   (*───────────────────────────────────────────────────────────────────────*)
  141.  
  142.   procedure Blanks2Zeros (var S : string);
  143.   begin  (* Blanks2Zeros *)
  144.     while (pos(' ', S) > 0) do
  145.       S[pos(' ', S)] := '0';
  146.   end;   (* Blanks2Zeros *)
  147.  
  148.   (*───────────────────────────────────────────────────────────────────────*)
  149.  
  150.   function Time2Str ( Time : TimeType) : string;
  151.   var
  152.     TimeStr : string;
  153.     UnitStr : string;
  154.  
  155.   begin (* Time2Str *)
  156.     str(Time.Hour:2, UnitStr);
  157.     TimeStr := UnitStr + ':';
  158.     str(Time.Minute:2, UnitStr);
  159.     TimeStr := TimeStr + UnitStr + ':';
  160.     str(Time.Second:2, UnitStr);
  161.     TimeStr := TimeStr + UnitStr + ':';
  162.     str(Time.Sec100:2, UnitStr);
  163.     TimeStr := TimeStr + UnitStr;
  164.  
  165.     Blanks2Zeros(TimeStr);
  166.  
  167.     Time2Str := TimeStr;
  168.   end;  (* Time2Str *)
  169.  
  170.   (*───────────────────────────────────────────────────────────────────────*)
  171.  
  172.   function Date2Str ( Date : DateType) : string;
  173.   var
  174.     DateStr : string;
  175.     UnitStr : string;
  176.  
  177.   const
  178.     DayName : array[0..6] of string[3] =
  179.       ('Sun', 'Mon', 'Tue', 'Wed', 'Thr', 'Fri', 'Sat');
  180.  
  181.   begin (* Date2Str *)
  182.     str(Date.Month:2, UnitStr);
  183.     DateStr := UnitStr + '-';
  184.     str(Date.Day:2, UnitStr);
  185.     DateStr := DateStr + UnitStr + '-';
  186.     str(Date.Year:4, UnitStr);
  187.     DateStr := DateStr + UnitStr;
  188.  
  189.     Blanks2Zeros(DateStr);
  190.     DateStr := DayName[Date.DayOfWeek] + ', ' + DateStr;
  191.  
  192.     Date2Str := DateStr;
  193.   end;  (* Date2Str *)
  194.  
  195.   (*───────────────────────────────────────────────────────────────────────*)
  196.  
  197. begin (* TimeDate2Str *)
  198.   TimeStr := Time2Str(TD.Time);
  199.   DateStr := Date2Str(TD.Date);
  200.  
  201.   TimeDate2Str := DateStr + ' @ ' + TimeStr;
  202. end;  (* TimeDate2Str *)
  203.  
  204. (*─────────────────────────────────────────────────────────────────────────*)
  205.